00100	C  ********** DISPLAYS MUSIC AND DRAWS IT ON THE PLOTTER **********
00200	C *** READS DATA FROM CLEF0, BDR40,BDI40, ETC.
00300	
00400		IMPLICIT INTEGER(A-Q,S-Z)
00500		REAL DIS,PWDS,DISX,A,B,STFF,CENTR,POS
00600		COMMON /DL/X22,SAVER,NAME/RRJJ/RJJ2,RJJ(20) /FONT/JFONT
00700		DIMENSION RPOS(2,40),LST(13),DP(-3/4),LX(14),LY(6),R(8,100)
00800		COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK/SIZ/RSZ,JCEN,KCEN
00900		COMMON/SCM/V(78),ISCR,LCNT,RSTF,LIST(200),REND
01000		COMMON/ALF/INP(72),ML/STF/RSTFAC(-3/4),RSTJ2
01050		1/POSI/STFF(-3/4),JJ2,POS
01100		COMMON /PLTR/PLT,RHT,DIS/PTR/PWDS(250),ITEM,L,I,IX
01200		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
01300		COMMON/XRN/RN(4000)/DPY/ST(4000),WDS(250),MEDIT,IGO	
01400		EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R5,RJQ(3))
01500		1,(R6,RJQ(4)),(J7,JQ(5)),(J8,JQ(6)),(J9,JQ(7)),(J10,JQ(8))
01600		1,(J11,JQ(9)),(J6,JQ(4)),(R7,RJQ(5)),(R4,RJQ(2)),(IT,LY(6))
01700		1,(R3,RJQ(1)),(I2,INP(2)),(I1,INP(1)),(LX(8),IL),(I3,INP(3))
01800		1,(R11,RJQ(9)),(NJR,R10,RJQ(8)),(RSET4,RN(3920)),(R,RN(3001))
01900		1 ,(TOP,ST(3999)),(BOT,ST(4000)),(R8,RJQ(6)),(RJ3,RJJ(1))
01950		1 ,(R9,RJQ(7)),(IBEAM,RN(3000))
02000		1,(RPOS(1,1),RN(3921)),(ST2,ST(2)),(IBL,LY(1)),(R13,RJQ(11))
02100		1,(IE,LX(4)),(IP,LX(10)),(IM,LX(9)),(II,LX(6)),(IS,LX(12))
02110		1,(LX(2),ICC),(LX(5),IG)
02200		DATA STFF/-369.0,-246.0,-123.0,0.0,123.0,246.0,369.0,450.0/
02300		1 ,LST/'NOTE','REST','CLEF','LINE','SLUR',
02400		1 'BEAM','TRILL','STAFF','MISC','NUMB','WORD','KSIG','METER'/
02500		1,DP/8*1/,LX/'A','C','D','E','G','I','J','L','M','P','R',
02600		1 'S','U','X'/
02700		1,LY/' ','A','B','D','E','T'/, DIS/1.0/
02800	
02860		LCEN=0
02870		MCEN=0
02900	CP	TOP2=-999
03050	C  IF -1, THEN TRUE OUTLINES OF FONTS ARE DISPLAYED.
03100		I1=0
03120	CP	DIS=1.
03140	CP	RHT=1.
03160	C  FOR 'FILLER' ON CRT.
03300	2	CALL DPYSET(1,ST,4000)
03310		CALL HYDPOG(1)
03400		CALL TYPLOC(-180,-511)
03500		CALL DPYBRT(5)
03510		JFONT=0
03520		RSET4=999
03600		RPOS(1,1)=0
03700	CP	PLOTIT=0
03800		RSZ=.845
03900	CP	TOP=-999
04000	CP	BOT=999
04200		X22=0
04300		JCEN=0
04400		KCEN=0
04500		PLT=0
04600		PWDS(1)=1.
04700		EDX=-1
04750		RN(2)=0
04775	C  FOR RESTART.  AVOIDS STAFF CODE NUM.
04800		SAVER=7
04900		DO 1402 K=-3,4
05000	1402	RSTFAC(K)=1.
05100		REDIT=999.
05200		M=1
05300		ITEM=0
05400		ZERO=-1
05500		WDS(1)=4
05600	C  DATA IN DPY ARRAY STARTS AT WD.4!
05700		I=1
05800	1100	SCORE=-1
07200	58	IGO=-1
07210		IF(I1.NE.'R')GO TO 5505
07250		CALL FORMAT(NAME)
07275		IF(NAME.NE.IBL)GO TO 1221
07287	C YOU CAN TYPE 'RS NAME' FOR QUICK RESTARTS
07300		GO TO 5505
07400	
07600	11	CALL NOTWRT
07700	CP57	IF(PLT)GO TO 6120
07710	57	IF(M.GT.I)GO TO 571
07800		IF(IGO)CALL DPYOUT(1)
08000	571	ITEM=ITEM+1
08010		IF(ITEM.LT.250)GO TO 17
08020		TYPE 170,ITEM
08030		I=PWDS(250)
08040		ITEM=249
08050		ST2=WDS(250)
08055		CALL DPYOUT(1)
08060		GO TO 1100
08070	170	FORMAT(2(' **** TOO MANY ITEMS ',I3,'/249'/))
08100	17	IF(IGO.GT.0)GO TO 20000
08200		K=ST2
08300		IF(X22.EQ.0)GO TO 20000
08400		CALL BOX(IBOX,RBOX,STFF)
08500		ST2=K
08600	20000	WDS(ITEM+1)=ST2
08610		IF(EDX.EQ.-1)GO TO 1571
08700		IF(M.LT.I)GO TO 6120
08800	CP1571	IF(PLOTIT.EQ.-2)GO TO 2311
08900	C  SL=SAVE AFTER RESETTING LENGTH OF PAGE.  (SEE I2 IN SCX)
09000	1571	PWDS(ITEM+1)=I
09100		PLT=0
09200		IF(IGO.NE.0)GO TO 55
09300		CALL DPYOUT(1)
09310		IF(SCORE.EQ.0)GO TO 9532
09355	C  GO GET MORE FROM SCX.
09400		IGO=-1
09500	
10200	55	IF(SCORE.EQ.0)GO TO 553
10300	5505	SVST=ST2
10400	C CATCHES TYPO WITH 'C'
10500		K=ITEM+1
10600		IF(X22.EQ.0)GO TO 5503
10700		K=X22
10800		L=RN(MEDIT+1)
10900		IF(L.EQ.13)L=11
10910	CC	IF(L.EQ.10)L=9
11000	CC	IF(L.GE.16.AND.L.LE.18)L=L-5
11020		IF(L.GE.11)L=L-1
11040		IF(L.GE.15)L=L-4
11100	CC	IF(L.EQ.20)L=12
11400		TYPE 427,LST(L),(RN(L),L=MEDIT+1,MEDIT+3)
11500		IF(YED.LT.2)GO TO 59
11505	CP	IF(YED.LT.2)GO TO 5504
11600	C   YED IS SET AT 426
11700	5502	DO 5501 L=4,YED+2
11800	5501	TYPE 4271,L,RN(MEDIT+L)
11900	CP	GO TO 5504
12000		GO TO 59
12300	
12400	5503	CALL HYDPOG(3)
12500	C  TO DELETE VERTICAL LINE (55)
12600		KED=0
12900	CP5504	IF(I1.EQ.IP)GO TO 2311
13000	59	TYPE 56,NAME,K,I,SVST
13100		JAB=JA
13200		SCORE=-1
13300		ACCEPT 89,INP
13400		DO 1313 L=1,14
13500	1313	IF(I1.EQ.LX(L))GO TO 2313
13600		GO TO 87
13800	C  'SA'=SAVE; 'S'=SET; 'SB'=SAVE BIG; 'ST'=STAFF; 
13900	2313	IF(X22.NE.0)GO TO(884,883,883,5313,87,884,87,883,87,59,883
14000		1,15,883,883),L
14090	CP	GO TO(87,13,7555,14,5313,120,884,7555,883,7555,311,883,15,883
14100		GO TO(13,7555,14,5313,120,884,7555,883,7555,59,883,15,883
14200		1,59),L
14300	C                  A   C   D   E   G   I  J   L   M     P   R   S U(X
14400	C  HERE A=ALTER A GROUP, DE=DELETE A GROUP
14500	C  'DP'=DISPLAY OR HIDE WHICH STAVES.  D=DOWN N
14600	14	IF(I2-IE)883,13,884
14700	13	IGO=1
14800		CALL GRED
14850		JFONT=0
14900		IF(JA.EQ.98)GO TO 5533
15000		KNT=0
15100		SCORE=0
15250		GO TO 653
15300	15	DO 3313 L=1,6
15400	3313	IF(I2.EQ.LY(L))GO TO(312,3121,3121,3121,312,884),L
15500	C                               BL  A    B     D    E   T
16000	3121	IF(X22.NE.0)GO TO 5505
16100		SAVER=7
16200		CALL SAVIT
16300		GO TO 5505
16400	312	JA=55
16500		R2=RN(MEDIT+3)
16550	C  POSITION OF ITEM LOOKED AT.
16600		R3=55.
16700		GO TO 6531
16800	C  ABOVE FOR 'S'ET ALIGNMENT
16900	C  'S'=SET ALIGNMENT, 'A'=ALIGN IT.  'M'=MOVER 'C'= COPIER
17000	C  'E'=EDIT; 'I'=ITEM; 'G'=GET; 'GM'=GET MORE;  'P' #S = PLOT IT
17100	5313	K=-1
17200		DO 882 JA=3,10
17300	882	IF(INP(JA).NE.IBL)GO TO 884
17400		GO TO 883
17500	885	FORMAT(A2,21F)
17600	884	REREAD 885,K,R2,RJQ
17700		JA=55
17800		IF(I1.EQ.II)JA=22
17900		IF(I2.EQ.IT)JA=44
18000		IF(I2.NE.IP)GO TO 6531
18100		IF(R2.GT.5)GO TO 1886
18200	C  GO BACK AND RESET ALL
18300		K=R2
18400		JA=0
18500	C  USE '5' FOR STAFF 0.
18600	888	IF(K.EQ.5)K=0
18700		DP(K)=-DP(K)
18800		JA=JA+1
18900		K=RJQ(JA)
19050		IF(K.EQ.0)GO TO 55
19100	C  JUMP OUT IF RJQ(JA)=0 OR 99
19150		IF(K.EQ.99)GO TO 85
19175	C*** 3/74  END WITH '99' TO MAKE DP RIGHT NOW!
19200		GO TO 888
19300	C  TO GET BACK ALL LINES TYPE 6+
19400	311	JA=0
19410		IGO=1
19500		ML=0
19600		IF(I2.NE.IL)GO TO 884
19700	1886	DO 2886 K=-3,4
19800	2886	DP(K)=1
19875		GO TO 85
19900	CP	IF(I1.NE.IP)GO TO 8851
20000	C PL RESETS 'DP'
20100	C  TO GET BACK OTHERS - 'DPY N' AGAIN WILL DO.
20200	CP2311	CALL PLTCMD
20300	CP	IF(PLOTIT.EQ.0)GO TO 3005
20400	CP	I1=IP
20500	CP	PLOTIT=-1
20600	CP	GO TO 6531
20700	C  'PL' GOES TO 'PLOT COMMAND' ROUTINE
20800	
20900	881	IF(I1.GT.0)GO TO 87
21000	C   JUMP IF I1 IS NOT A LETTER (K>0=NUM, K<0=LET.)
21100	883	IF(I2.EQ.IS)GO TO 2
21200	C  TYPE 'RS' TO RESTART.
21210		IF(IX.NE.I)GO TO 8831
21300		IF(I1.EQ.ICC)GO TO 72
21320	8831	IF(JA.NE.16)GO TO 8832
21330		IF(X22.EQ.0)GO TO 5505
21340	C  CAN'T MOVE LETTERS OR 'SCORE' ENTRIES UNLESS REALLY IN EDIT MODE!
21400	8832	CALL EDIT(JJA)
21500		IF(JA.NE.99)GO TO 6531
21520		CALL DELETE
21540	C  DELETE ROUTINE COULD BE PUT DIRECTLY IN HERE.
21560		GO TO 425
21600	89	FORMAT(72A1)
21700	C  TYPE L, R, U OR D OR EDIT TO MOVE LAST ENTERED ITEM.
21710	
21720	101	CALL SCL
21730		GO TO 5505
21740	221	JFONT=R2
21750	C JA=44 IS FOR JFONT (DISPLAY FONT OUTLINES)-WIPED OUT BY '24' ETC.
21760		GO TO 5505
21770	440	RSET4=R2
21780	C  SETS "SETUP" STAFF NUMBER
21790		GO TO 5505
21800	
21900	87	REREAD 1,JA,R2,RJQ
22000		IF(K)JA=55
22100	C   ED 47 -1 = 55 47 -1, ETC.
22200		IF(JA.EQ.101)GO TO 101
22220		IF(JA.EQ.44)GO TO 221
22225		IF(JA.EQ.444)GO TO 440
22230		IF(JA.EQ.14)GO TO 88
22235	C  IS THERE A BUG CONCERNING SAVIT AND 'SCORE'????
22240		IF(JA.EQ.144)GO TO 88
22300		IF(JA.GT.0)SAVER=SAVER-1
22310		IF(X22.NE.0)GO TO 6531
22312		IF(JA.EQ.0)GO TO 5505
22356	C  CATCHES ZEROS AND LOWER CASE LETTERS.
22400		IF(SAVER)CALL SAVIT
22500	C  SAVES EVERY 7TH TIME AROUND
22610	CC8833	IF(JA.EQ.14)GO TO 88
22655	CC	IF(JA.EQ.144)GO TO 88
22700	8833	IF(JA.NE.16)GO TO 6531
22710	C NEXT FOR ALPHA TEXT ITEMS.
22720		M=I
22730		CALL WORDS
22740		GO TO 8852
22750	
22800	188	R3=0
23000	CC88	SET4=R3
23100	C  *** THIS FEATURE CHNGD. 6/75***SET4 IS NEG. FOR AUTOMATIC STAFF 4 SETUP.
23110	88	SCORE=0
23200		IF(JA.NE.14)GO TO 889
23300	C NEXT PUTS UP STAFF IF IT WASN'T THERE ALREADY
23400		SAVER=-1
23410		RSTF=R2
23420		IF(R3)R3=0
23500		DO 1889 K=1,ITEM
23600		J=PWDS(K)
23700		IF(RN(J+1).NE.8)GO TO 1889
23800		IF(RN(J+2).EQ.R2)GO TO 890
23900	1889	CONTINUE
24000	C DIDN'T FIND THIS STAFF
24100		M=2000
24120		IGO=0
24200		JA=8
24300		GO TO 6531
24320	890	JA=14
24340		ITCHK=ITEM
24360		ICHK=I
24380		IDPY=ST2
24400	C ALL THIS FOR BACKUPS
24450	889	SPD=ST2
24460		JIT=ITEM
24500		ISC=I
24510		REND=0
24700	C   RETAINS ORIGINS OF SCORE SQUENCE
24800	9532	IF(REND.EQ.2)GO TO 889
24850	C  FOR READIN CONTINUATION.
24900		M=ISC
24905	9533	IF(JA.EQ.8)GO TO 890
24910		IF(REND)GO TO 9535
24955	C  REND=0 GO,   -1=NORMAL END,  1=ABORTED
25000		CALL SCMSS
25100		IF(REND.EQ.1)GO TO 9535
25110		IF(REND.NE.99)GO TO 9534
25111	CC	I=ISC
25113		I=ICHK
25115		ITEM=ITCHK
25116		ST2=IDPY
25117		CALL ACCPOG(1)
25118		CALL DPYOUT(1)
25119		GO TO 9535
25120	9534	ITEM=JIT
25130		J=M
25140	9536	ITEM=ITEM+1
25150		PWDS(ITEM)=J
25160		J=J+RN(J)+3
25170		IF(J.LT.I)GO TO 9536
25180		IF(IBEAM)GO TO 9537
25182		R13=0
25185		R2=RSTF
25186		JA=19
25187		J3=0
25189		CALL HOMER
25190	9537	ITEM=JIT
26012		ST2=SPD
26075		GO TO 8852
26200	9535	SCORE=-1
26220		IGO=-1
26260		JA=16
26280	C  FOR TRAP AT 'EDIT'
26290		GO TO 5505
26295	
26300	553	IF(SCORE)GO TO 6531
26600	653	KNT=KNT+1
26700	C   NUM OF ITEMS IN LIST
26800		R11=0
26900		R10=0
27000		R9=0
27100	64	JA=R(1,KNT)
27200	264	R2=R(2,KNT)
27300		IF(JA.NE.0)GO TO 550
27350	C  =0 MEANS NO MORE ITEMS.
27700		CALL DPYOUT(1)
27900		GO TO 1100
27920	
28000	5533	X22=0
28011		IGO=-1
28022		CALL DPYNEW
28033		GO TO 55
28044	
28055	CP590	IF(PLOTIT.EQ.-1)GO TO 121
28066	CP	I1=0
28077	CP	GO TO 243
28088	C  GOES TO PLOTTER
28100	550	DO 7531 K=1,6
28200	7531	RJQ(K)=R(K+2,KNT)
29500	6531	M=1
29600		EDX=-1
29700		IF(JA.EQ.222)GO TO 72
29800		IF(JA.EQ.2222)GO TO 73
29900		DO 5532 K=1,20
30000	5532	JQ(K)=RJQ(K)
30100	CC	J2=R2
31300	CP7542	IF(I1.EQ.IP)GO TO 590
31400	C  X22= ITEM# WHEN EDITING OR DELETING.
31500		IF(X22.NE.0)GO TO 5511
31600		IF(JA.GT.0)GO TO 155
31700		IF(R2.EQ.0)GO TO 5505
31800	C  FOR UP, DOWN, LEFT, RIGHT
31850		RJJ2=J2
31900		GO TO 6221
32000	C  GOES BACK IF NEGATIVE AND NOT IN EDIT MODE.
32100	155	IF(JA.EQ.24)GO TO 24
32200		IF(JA.EQ.22)GO TO 42  
32300		IF(JA.EQ.44)GO TO 44
32350	C  THIS '44' IS SET IN 'EDIT' - IT'S NEVER TYPED.
32400		IF(JA.EQ.55)GO TO 554
32500		IF(JA.EQ.333)GO TO 6333
33050		IF(JA.EQ.19)GO TO 61
33100		GO TO 60
     

00100	33	J2=R2
00200		TYPE 1,J2,RJJ(J2-2)
00500	C  TYPE 33,N TO SEE FULL CONTENTS OF PARAM. N.
00600		GO TO 5505
00700	
00800	24	IGO=0
00850		CALL HYDPOG(2)
00875	C  TO ERASE SPACING SCALE.
00900		IF(X22.EQ.0)GO TO 23
01000		R2=RHORZ(RN(MEDIT+3))
01100		M=RN(MEDIT+2)
01200		R4=RN(MEDIT+4)*RSTFAC(M)+STFF(M)
01300		ITEM=ITEM-1
01400	C  PICKS UP POINT FROM CURSOR IN 'BOX'
01500		CALL CLRCUR
01600		X22=0
01700		GO TO 241
01800	23	IF(R2.LT.100)GO TO 2410
01900		R5=AMOD(R2,100.)
02000		R2=IFIX(R2/100.)
02100		R3=1000.*R5-500.
02200		R4=R2*50.
02300	C TYPE 24 200.5 FOR 1ST HALF OF DOUBLE, 301 FOR LAST THIRD OF TRIPLE
02400	2410	IF(R2.NE.0)GO TO 241
02500		IGO=-1
02600	243	R2=1.
02700	C TO REDISPLAY WITH MAGNIFICATION - OR JUST RUN THROUGH DATA.
02800	241	RSZ=.845*R2
02900		JCEN=R3*RSZ
03000		KCEN=R4*RSZ
06200	2312	R2=0
06300		R3=0
06400		R4=0
06700		LCEN=0
06800		MCEN=0
06900	CC	RJSZ=1.
07000	C IF P5 ≠ 0 GOES THROUGH DATA IN OLD WAY.
07050		JFONT=0
07100	85	M=1
07200		I=PWDS(ITEM+1)
07300		ITEM=0
07400	8552	ST2=3
07500	8852	PLT=1
07600		EDX=0
07700		CALL ACCPOG(1)
07710		IF(JA.EQ.0)GO TO 6120
07800		IF(JA.NE.24)IGO=0
07900		GO TO 6120
08000	
08100	6333	CALL LISTP(LST)
08200		GO TO 5505
08300	
08400	172	CALL JUGGLE
08500		CALL CLRCUR
08600		CALL DPYNEW
08700		IF(JA.EQ.22)GO TO 424
08800	C  FOR MOVING DIRECTLY TO NEW ITEM IN EDIT MODE.
08900		IF(ZERO)GO TO 55
09000		X22=ZERO
09100		ZERO=-1
09200		IF(JA.EQ.55)GO TO 554
09300		IF(JA.EQ.44)GO TO 44
09400		IF(KED.NE.0)GO TO 244
09500		GO TO 425
09600	
09700	C  55,POS  -- SETS UP ALIGNMENT
09800	554	CALL BOX(-1,R2,STFF)
09900		IF(J4.EQ.0)KED=-1
10000		RITEM=R4
10100	C  FOR 'ED POS., STF., CODE#'
10200		IF(J3.GT.4)KED=-2
10300		RLINE=R2
10400		R2=R3
10500		GO TO 45
10600	
10700	C  '22,0' EDITS LAST ITEM ENTERED
10800	42	REDIT=999.0
10900		IF(R2.NE.0)GO TO 242
11000		X22=ITEM
11100		GO TO 429
11200	44	KED=1	
11300		RITEM=R3
11400	C  'ST', STF#, CODE# (IF 0, ALL ITEMS COME UP) - STF>4 = ALL STAVES.
11450		IF(R2.GT.4)KED=2
11500	45	REDIT=R2
11600	C  THE STAFF #
11700		JED=1
11800	244	X=ITEM  
11900		IF(JED.GT.X)GO TO 444
12000		DO 144 K=JED,X
12100		L=PWDS(K)
12200		IF(KED.EQ.-2)GO TO 654
12300	C  -2 LOOKS AT ALL ITEMS NEAR VERT. LINE, -1 ON SINGLE STAFF.
12310		IF(KED.EQ.2)GO TO 656
12400		IF(RN(L+2).NE.REDIT)GO TO 144
12500		IF(KED)GO TO 654
12510		IF(RITEM.EQ.0)GO TO 655
12600	656	IF(RITEM.NE.RN(L+1))GO TO 144
12700	655	IF(JA.NE.55)GO TO 344
12800	654	IF(ABS(RLINE-RN(L+3)).LT.5.0)GO TO 344
12900	144	CONTINUE
13000	444	REDIT=999.
13100	C  NO MORE ON LINE
13200		R2=0
13300	C   SO IT WILL RETURN IF NOTHING IS FOUND WITH 'ED' OR 'ST'.
13400		GO TO 73
13500	344	JED=K+1
13600	C  FOR NEXT TIME AROUND
13700		X22=K
13800		GO TO 429
13900	C  CR MOVES ALONG GIVEN LINE,  222 LEAVES THIS MODE
14000	
14100	91	CALL ACCPOG(1)
14200		IF(I.EQ.IX)ITEM=ITEM-1
14300		GO TO 142
14400	242	IF(X22.GT.0)GO TO 5511
14500	142	IF(R2.NE.0)GO TO 424
14510		IF(REDIT.EQ.999)GO TO 1554
14600		IF(JA.GE.0)GO TO 244
14700	1554	X22=X22+1
14800		IF(JA)X22=X22-1+JA
14900		IF(X22.LT.1)X22=1
15000		GO TO 425
15100	427	FORMAT(1XA5/,2F6.0,F10.2,$)
15200	4271	FORMAT('+  (',I2,')',F7.2,$)
15300	
15400	C  FOR EDITING
15500	5511	IF(JA.EQ.55)GO TO 420
15600	220	IF(JA.NE.22)GO TO 720
15700	C  'I, #' WILL MOVE TO ANOTHER ITEM WHEN ALREADY IN EDIT MODE.
15800		KED=0
15900		JED=0
16000		GO TO 72
16100	720	IF(JA.EQ.44)GO TO 420
16200		IF(JA.EQ.33)GO TO 33
16300		IF(JA.EQ.24)GO TO 24
16400	C  FOR '24' WHILE IN EDIT MODE.  MAGS WITH CURSOR AS CENTER.
16500		IF(MOD(JA,100).GT.13.OR.JA.EQ.1)GO TO 5505
16550	CC	IF(JA.GT.13.OR.JA.EQ.1)GO TO 5505
16600	C  PARAM NUM TOO HIGH?
16700	C  LOOKS FOR NEXT ITEM TO EDIT IF <CR>
16800	4221	IF(X22.EQ.0)GO TO 5517
16850		IF(R2.NE.0)GO TO 5517
16900	C  BACKS UP WHEN IN EDIT MODE.
17000	
17100		IF(JA.GT.0)GO TO 5518
17200		IF(I.EQ.IX)GO TO 91
17300		ZERO=X22+1
17400	C  '0' AFTER AN EDIT ENDS THE EDIT AND GETS NEXT ITEM FOR EDIT.
17500	72	IF(X22.EQ.0)GO TO 55
17600		IF(KED.EQ.0)REDIT=999.
17700	320	IF(I.NE.IX)GO TO 172
17800		ITEM=ITEM-1
17900	C  TO DELETE AN ITEM
18000	73	X22=0 
18100		CALL CLRCUR
18200		CALL DPYNEW
18300		IF(REDIT.EQ.999.)GO TO 441
18400		IF(JA.EQ.55)GO TO 554
18500		IF(JA.EQ.44)GO TO 44
18600	441	IF(R2.EQ.0.OR.R2.GT.ITEM)GO TO 55
18800	C  DELETION IN EDIT MODE DOES NOT LEAVE MODE.
18900	424	X22=R2
19000	425	IF(X22.GT.ITEM)GO TO 73
19100	C  LEAVES EDIT MODE.
19200	429	IX=I
19300		MEDIT=PWDS(X22)
19400		J=2
19500	426	Y=RN(MEDIT)+J
19601		CALL LOOP(0,Y,1,I,MEDIT,RN)
19700		JJA=RN(I+1)
19800		YED=Y-2
19900		L=I+2
20000		DO 422 K=1,11
20100		IF(K.GT.YED)GO TO 423
20200		RJJ(K)=RN(L+K)
20300		GO TO 422
20400	423	RJJ(K)=0
20500	422	CONTINUE
20600		RJJ2=RN(L)
20700		IF(IGO.GT.0)GO TO 4231
20800	C  NO BOX WHEN IN GROUP EDIT ROUTINE
20900		IBOX=I
21000		RBOX=RJJ2
21100		CALL BOX(IBOX,RBOX,STFF)
21200	4231	ITEM=ITEM+1
21300		ST2=WDS(ITEM)
21400		GO TO 55
21500	
21600	5517	IF(JA.EQ.0)GO TO 6221
21650	5518	X=100-JA
21675		IF(X)JA=JA/100
21700		IF(JA.EQ.2)GO TO 7221
21800		IF(JA.GE.22)GO TO 55
21805		I1=JA-2
21810		IF(X)GO TO 224
21900		RJJ(I1)=R2
22100		GO TO 6222
22110	224	RJJ(I1)=RJJ(I1)+R2
22120		GO TO 6222
22200	
22300	7555	CALL MOVER
22400		IF(R3.EQ.99)GO TO 59
22405	CP	IF(R3.EQ.99)GO TO 5504
22500	C   99=BACKUP OUT OF MOVER ETC.
22600		IGO=0
22605		JFONT=0
22607	C  SO IT WON'T DO ALL FONT LOOKUPS.
22610	8853	IF(JJ2)GO TO 5505
22700		M=PWDS(JJ2)
22800		I=PWDS(ITEM+1)
22900		ITEM=JJ2-1
23000		ST2=WDS(JJ2)
23100	C SO IT DOESN'T HAVE TO GO THROUGH ALL ITEMS
23200		GO TO 8852
23300	
23400	CP8851	IF(I1.NE.IP)GO TO 85
23500	CP	GO TO 6531
23600	
23700	420	REDIT=0
23800	211	IF(R2.NE.0)GO TO 320
23900		IF(KED.GE.0)RLINE=RJ3
24000	CC	R3=RLINE
24025		RJ3=RLINE
24050	CC	X=0
24062		GO TO 6222
24100	C  FOR '55' ALIGNING
24110	7221	IF(X)GO TO 4223
24200		RJJ2=R2
24210		GO TO 6222
24220	4223	RJJ2=R2+RJJ2
24300	CC6222	IF(JQ(1).EQ.0)GO TO 6221
24400	C  ARRAYS NEED 2O LOCATIONS HERE.
24500	C CHNG PARAMS WITH PAIRS OF NUMS.(EG. 2,122  4,13  5,-2 ETC.)
24600	6222	DO 1222 K=1,20,2
24700		L=JQ(K)
24705	CC	IF(L.EQ.0)GO TO 5223
24707		IF(L.EQ.0)GO TO 6221
24710		JA=100-L
24720		IF(JA)L=L/100
24730	C  600 2  WILL ADD 2 TO PARAM 6.
24740		RD=RJQ(K+1)
24745		X=L-2
24750		IF(JA.GT.0)GO TO 223
24760		IF(L.EQ.2)GO TO 1223
24770		RD=RJJ(X)+RD
24780		GO TO 2223
24790	1223	RD=RJJ2+RD
24800	223	IF(L.EQ.2)GO TO 3223
24810	2223	RJJ(X)=RD
24820		GO TO 1222
24830	3223	RJJ2=RD
25300	1222	CONTINUE
25400	C***  LOOP SET TO 11 (20 IN ARRAY!) ONLY 13 PARAMS POSSIBLE NOW.
25450	CC5223	R2=RJJ2
25500	6221	DO 5514 K=1,11
25600		RJQ(K)=RJJ(K)
25700	5514	JQ(K)=RJQ(K)
25750		R2=RJJ2
25800		JA=JJA
25900		ITEM=ITEM-1
26000		IF(ITEM)ITEM=0
26100		ST2=WDS(ITEM+1)
26200		I=PWDS(ITEM+1)
26300		CALL DPYNEW
     

00100	60	J2=R2
00200		RSTJ2=RSTFAC(J2)
00300	CL	RD=0
00400		IF(JA.NE.2)GO TO 163
00500	CJ	IF(R9.EQ.0)GO TO 163
00510		IF(R8.EQ.0)GO TO 163
00520		IF(R8.EQ.-1)GO TO 163
00530	C R8=0=AS IS; -1=WHOLE REST; >0=NUMBER OVER REST; -2=CENTERED
00600		K=ITEM
00700	C  ITEM+1 IS CURRENT ITEM IN QUICK RUN-THROUGHS.
00800		IF(X22.NE.0)K=X22-1
00805		RD=1.75*RSTJ2
00810		L=PWDS(K+2)
00815		IF(RN(L+1).NE.4)GO TO 164
00817	C  GO ON IF NEXT ISN'T BAR LINE (CODE 4. COULD FIND OTHER LINES!!)
00820		RB=RN(L+3)
00830		L=PWDS(K)
00840	C  CHECK PREV. AND NEXT ITEM.  IF NOT BAR, DON'T TRY TO CENTER!
00860		IF(RN(L+1).NE.4)GO TO 164
00960		RA=RN(L+3)
01200		R3=RA+(RB-RA)/2-1.75*RSTJ2
01300	164	IF(PLT.EQ.0)GO TO 160 
01400		RN(IFIX(PWDS(K+1))+3)=R3
01500	C  ******* A DANGEROUS PLACE.  KEEP TRACK OF THIS
01600		GO TO 5541
01700	
01800	163	IF(JA.EQ.16)GO TO 63
01900		IF(PLT.NE.0)GO TO 5541
02000		IF(JA.NE.8)GO TO 70
02100		IF(R9.NE.1)GO TO 70
02200		R9=RN(MEDIT+9)
02250		RD=R9
02300		IF(R9.NE.' ')TYPE 427,R9
02400		TYPE 21
02500		ACCEPT FA5,R9
02550		IF(R9.EQ.' ')R9=RD
02600	CC	IF(R9.EQ.'0')R9=0
02700	C  WHEN P9=1 ASKS FOR ID NAME FOR THE STAFF (FOR PART EXTRACTOR)
02800	70	IF(JA.NE.11)GO TO 160
02900	C  ↑↑↑↑ WAS - TO 63
03000		IF(J10.NE.1)GO TO 62
03050		L=NJR
03100		TYPE 21
03200		ACCEPT FA5,NJR
03300	C   P10←1 GETS NAME OF BASIC DRAW FILE, PUTS IT IN P10 (NJR)
03350		IF(NJR.EQ.LY(1))NJR=L
03400		LASTNM=NJR
03500	62	IF(NJR.EQ.0)NJR=LASTNM
03600	C  IF NO NAME ASKED FOR, IT TAKES LAST NAME GIVEN.(SOLVES SORT PROB?)
03700		GO TO 160
03800	CC63	IF(JA.EQ.50)JA=16
03900	C  ABOVE SHOULD BE TAKEN OUT AT SOME FUTURE DATE. (12/73)
04000	CL63	IF(R3.LT.1000)GO TO 66
04100	CL	RD=R3
04200	CL	IF(JA.EQ.5)R13=R3/1000.
04300	CL	CALL RNOTE(R3)
04400	C IF R3>1000 IT FINDS TRUE R3 THROUGH NOTE NUMB.
04500	CL66	IF(JA.NE.16)GO TO 160
04600	CX63	IF(JA.NE.16)GO TO 160
04700	C  USE P10≠0 TO LINK UP TEXT.
04800	CCZZZZZZ	IF(J10.EQ.0.OR.PLT.NE.0)GO TO 160
04900	63	IF(J10.EQ.0)GO TO 162
05000	CX	R10=0
05100		L=ITEM
05200		IF(X22.NE.0)L=X22-1
05300		IF(J10.EQ.1)GO TO 263
05400	C NEXT FOR CENTERING OF TEXT.  P10>1
05500		RB=0
05600		X=PWDS(L+1)
05700	363	L=L+1
05800		K=PWDS(L)
05900		RB=RB+RN(K+9)
06000	C  ADD SPACE NEEDED
06100		K=PWDS(L+1)
06200		IF(RN(K+1).NE.16)GO TO 463
06300		IF(RN(K).EQ.8)GO TO 363
06400	C GO BACK IF MORE LETTERS TO COME
06500	463	R3=R10-(RB-3.4)*R5*RSTJ2/2.
06600	C  +3.4 IS TO COMPENSATE FOR STARTING POS. BEING IN CENTER OF LET.
06700		R10=0
06800		IF(RN(X).EQ.8)RN(X+10)=0
06900		RN(X+3)=R3
07000	C THESE ARE NEEDED FOR ITEMS CENTERED DIRECTLY FROM 'WORDS'
07100		GO TO 162
07200	263	K=PWDS(L)
07300		R3=R5*RSTJ2*RN(K+9)+RN(K+3)
07400		RN(IFIX(PWDS(L+1))+3)=R3
07500	C  PUTS POS. BACK INTO RN ARRAY EVERY TIME.
07600	C  PUTS 13TH(+) LETTER IN RIGHT POS. 
07700	162	IF(PLT.NE.0)GO TO 5541
07800	CX160	IF(EDX.NE.0)GO TO 162
07900	CP	IF(I1.EQ.IP)GO TO 5541
08000	CX162	RJ3=R3
08100	160	RJ3=R3
08200		JJA=JA
08300		IF(R8.NE.0)GO TO 161
08400		IF(JA.EQ.1)R8=999.
08500	C  999=0 FOR STEM EXTENSIONS.
08600	CL161	CNT=1
08700	CL	DO 5543 K=1,9
08800	C  10/6/73 ABOVE WAS ,11
08900	CL	RA=RJQ(K)
09000	CL	IF(RA.NE.0)CNT=K
09100	CL5543	RJJ(K)=RA
09200	C  USES ONLY 10 PARAMETERS BEYOND JA, J2
09300	161	CALL MSSLUP
09400	CP2554	IF(PLT.NE.0)GO TO 5541
09500		IF(JA.EQ.6)CALL HOMER
09600		IF(JA.NE.13)GO TO 1261
09700		IF(J6.NE.0)R13=-1
09800	
09900	1261	IF(R13.EQ.0)GO TO 261
10000		CALL HOMER
10100		IF(JA.EQ.10)R3=R3+RSTJ2
10200	C ABOVE HELPS CENTER NUMBERS UNDER NOTES(BECAUSE R3 IS AT CENTR OF NUM)
10300	C  IF P13≠0 ANY ITEM WILL LINE UP WITH ANY OTHER ITEM. P13 IS RESET=0
10400	C **** FOR '0' EDITS ******
10500	CL261	RN(I)=CNT
10600	CL	RN(I+1)=JA
10700	CL	I=I+2
10800	CL	RN(I)=R2
10900	CL	IF(RD.NE.0)RN(I)=RD
11000	C TO SAVE NOTE NUMBS IN P2.
11100	CL	DO 4554 K=1,CNT
11200	CL4554	RN(I+K)=RJQ(K)
11300	CL3554	I=CNT+1+I
11400	261	CALL LUP2
11500	5541	IF(DP(J2))GO TO 57
11600	C*** 3/74  NEW DP SYSTEM
11700	C  WHAT ABOUT EDITS?*******
11800		POS=STFF(J2)
11900		J3=ROFF(RHORZ(R3))
12000	C  LINE IS DIVIDED INTO 200 POINTS.
12100		CALL CENTX
12200	C  SETS VERT.(CENTR) POSITION BASED ON STAFF AND R4
12300		R3=J3
12400		IF(JA.LE.2)GO TO 11
12500	551	GO TO(1,1,68,25,67, 25,116,125,11,69, 68,67),JA
12600		GO TO (116,81,80),JA-15
12700	C  FOR 16,17,18 (WORDS, KSIG, METER)
12800	
12900	222	I=PWDS(ITEM+1)
13000		GO TO 5505
13100	C  44 1; JFONT=ONE DISPLAYS FONTS - THIS ALSO CATCHES SOME TYPOS
13200	
13300	69	CALL MAKNUM(R5)
13400		GO TO 57
13500	
13600	68	CALL CLEFS
13700		GO TO 57
13800	
13900	67	CALL SLUR
14000		GO TO 57
14100	
14200	116	CALL ALPHA
14300		GO TO 57
14400	
14500	81	CALL KSIG
14600		GO TO 57
14700	
14800	80	CALL METER
14900		GO TO 57
15000	
15100	61	CALL HOMER
15200		GO TO 8853
15300	125	IF(R2.EQ.0)RMOV=R8
15400	25	CALL ITMSUB
15500	C   BAR LINES, BEAMS, STAFF LINES ****
15600		GO TO 57
15700	
15800	C  TO GET DISPLAY: 'G'; 'GM'  ADDS TO DPY; 
15900	120	IF(I.EQ.1)GO TO 1220
16000		IF(I2.NE.IM)GO TO 222
16100	C  'GM'=GET MORE
16200	1220	CALL FORMAT(NAME)
16300	C  NOW TYPE 'G NAME' OR 'GM NAME'
16400		IF(NAME.NE.IBL)GO TO 1221
16500	1225	TYPE 21
16600		ACCEPT FA5,NAME
16700		IF(NAME.EQ.'99')GO TO 5505
16800		IF(NAME.EQ.IBL)GO TO 2220
16900	1221	IF(LOOKD(NAME).EQ.0)GO TO 1225
17000	C  FUNC. LOOKD IS 'FAIL' PROG. TO CHECK ON LOOKUPS
17100	2220	JA=-1
17200	C  -1 IS FOR 8852+3
17300	3005	REWIND 21
17400	C  GUARDS AGAINST LOSSAGE!
17500	CP	PLOTIT=-1
17600	CP	IF(I1.NE.IG)PLOTIT=-2
17700	2005	IF(NAME.EQ.IBL)GO TO 2200
17800		CALL IFILE(21,NAME)
17900	C  JUMP TO READ BIG FILES
18000	2200	J=ITEM+1
18100	2202	READ(21,END=2207),X,Y,
18200		1 (PWDS(K),K=J,X+J),(RN(K),K=I,Y+I-2),ISCR,(V(K),K=1,ISCR),
18300		1 LCNT,(LIST(K),K=1,LCNT),RSTFAC,STFF,RPOS
18400	C (K) BUG IN FORTRAN UNFORMATTED READ-WRITE. SOMETIMES LAST ITEMS WRONG.
18500	2207	ITEM=ITEM+X
18600		IF(I2.EQ.IM)GO TO 2203
18700		I=Y
18800	CPPPPP   8851 IS NOW 85
18900		READ(21,END=85),RSTFAC,STFF
19000	CC	IF(I1.EQ.IP)GO TO 6531
19100	CPPPPP   8851 IS NOW 85
19200	22222	READ(21,END=85),ST2,(ST(K),K=1,ST2+2),(WDS(K),K=1,ITEM+1)
19300		CALL DPYNEW
19400		GO TO 5505
19500	
19600	2203	RA=I-1
19700		DO 2204 K=J,J+X
19800	2204	PWDS(K)=PWDS(K)+RA
19900		GO TO 85
20000	CP121	IF(PLOTIT.EQ.0)GO TO 5504
20100	CP5121	CALL PLTSRT
20200		M=IX
20300	C  IF P5=0 MOVES UP AT START, IF P6=0 MOVES UP AT END.
20400	CC	PLT=-1-J8
20500	CP	PLT=-1
20600	C  (J8) P8=1 OR 2 FOR 2-PASS PLOTS
20700	CC	M=I
20800	CC	I=I+M-1
20900	C M IS SET UP IN PLTSRT
21000	CP	CALL NOZERO(R2)
21100	CP	DIS=R2*1.24
21200	CP	IF(R3.EQ.0)R3=R2
21300	CP	RHT=R3*1.2
21400	C   1.24 AND 1.2 ARE TO FIT 8 1/2 X 11 FORMAT
21500	CP	BOT=-BOT*RHT
21600	CP	IF(TOP2.EQ.-999)GO TO 8121
21700	CP	BOT=BOT+TOP2
21800	CP	GO TO 9121
21900	CP8121	CALL PLOTS(K)
22000	CP	RNOMOV=0
22100	CP9121	IF(R7.EQ.0)R7=RMOV
22200	C RMOV HAS INCHES FROM P8 OF STAFF 0.
22300	CP	IF(RNOMOV.GT.1)BOT=RNOMOV
22400	CP	RNOMOV=R6+R7*200.*R3
22500	CC	RNOMOV=R6+R7*202.*R3
22600	CP	RMOV=0
22700	C  R6=1 FOR NO MOVE AT END.  R7=INCHES TO MOVE FOR NEW STAFF 0.
22800	C RE. R7:DISTANCE IS MEASURED FROM BOTTOM LINE OF STANDARD POSITION
22900	C OF STAFF 0 UP TO LOWEST!! POINT FOUND IN FOLLOWING FILE.  THEN
23000	C NEXT SHIFT IS AGAIN FROM STANDARD STF.0 TO NEXT FILE'S LOW POINT.
23100	CP	IF(J5.NE.0)GO TO 6120
23200	CP6121	CALL PLOT(0,BOT,-3)
23300	C  MOVES PLOTTER UP IF P5=0.
23400	
23500	C  NEXT RUNS THROUGH DATA WITH NEW CHANGES.
23600	6120	IF(M.GE.I)GO TO 7120
23700		CALL RUNTHR(M)
23800	CF	CNT=RN(M)
23900	C  CLEARS INPUT ARRAY, USES ONLY 12 PARAMS.
24000	CF	DO 6220 K=CNT+1,10
24100	CF	JQ(K)=0
24200	CF6220	RJQ(K)=0
24300	CF	JA=RN(M+1)
24400	CF	M=M+2
24500	CF	R2=RN(M)
24600	CF	DO 9120 K=1,CNT
24700	CF	RJQ(K)=RN(M+K)
24800	CF9120	JQ(K)=RJQ(K)
24900	CF	M=CNT+M+1
25000		IF(EDX.LE.0)GO TO 60
25100		GO TO 5505
25200	
25300	7120	M=1
25400	CP	IF(EDX)GO TO 71201
25500		IF(PLT.EQ.1)EDX=-1
25600		PLT=0
25700		GO TO 5505
25800	CP71201	X=50*RHT
25900	CP	TOP=TOP*RHT+X
26000	CP	IF(RNOMOV.NE.0)TOP=0
26100	CP	IF(RNOMOV.GT.1)TOP=RNOMOV
26200	CP	CALL PLOT(0,TOP,3)
26300	CP	TOP2=TOP
26400	CP	GO TO 2
26500	C  TO MOVE 'PLOTTER' FOR XGP OUTPUT
26600	CC7121	CALL PLOT(0,TOP,3)
26700	C  MOVES PLOTTER UP
26800	C  ALWAYS START PLOT WITH BOTTOM UNIT ON PAGE AND WORK UP.
26900	CC	TOP2=TOP
27000	CC	GO TO 2
27100	
27200	56	FORMAT(/1XA5,'  TYPE FOR ITEM #',I3,I,I6/)
27300	1	FORMAT(I,24F)
27400	21	FORMAT(' FILE NAME?  '$)
27500		END